unit uDZTrace;

interface

{$INCLUDE DZCompiler.inc}

uses
  SysUtils, Classes, Windows, uDZSysUtils, uDZStr;

type
  // debug infmtion severity 
  TDzTraceSeverity = (tsDebug, tsInformation, tsWarning, tsError);

  TDzTraceVerbosity = set of TDzTraceSeverity;
  
const
  TRACE_SEVERITIES_ALL = [tsDebug, tsInformation, tsWarning, tsError];

type
  TTraceOption = (toSeverityTag, toTimeTick);
  TTraceOptions = set of TTraceOption;

  IDzTrace = interface(IDzBaseInterface)
    procedure Flush;
    function GetVerbosity: TDzTraceVerbosity;
    procedure SetVerbosity(const value: TDzTraceVerbosity);
    function GetOptions: TTraceOptions;
    procedure SetOptions(const value: TTraceOptions);
    function GetDateTimeFormat: string;
    procedure SetDateTimeFormat(const value: string);
    procedure Write(sev: TDzTraceSeverity; const text: AnsiString); overload;
    procedure Write(sev: TDzTraceSeverity; const text: WideString); overload;
    procedure Writeln(sev: TDzTraceSeverity; const text: AnsiString); overload;
    procedure Writeln(sev: TDzTraceSeverity; const text: WideString); overload;
    procedure FormatWrite(sev: TDzTraceSeverity; const fmt: AnsiString;
      const args: array of const); overload;
    procedure FormatWrite(sev: TDzTraceSeverity; const fmt: WideString;
      const args: array of const); overload;
    property Verbosity: TDzTraceVerbosity read GetVerbosity write SetVerbosity;
    property Options: TTraceOptions read GetOptions write SetOptions;
    property DateTimeFormat: string
      read GetDateTimeFormat write SetDateTimeFormat;
  end;

  TDzTrace = class(TDzInterfacedObject, IDzTrace)
  private
    function GetVerbosity: TDzTraceVerbosity;
    function GetOptions: TTraceOptions;
    function GetDateTimeFormat: string;
    procedure Write(sev: TDzTraceSeverity; const text: AnsiString); overload;
    procedure Write(sev: TDzTraceSeverity; const text: WideString); overload;
    procedure Writeln(sev: TDzTraceSeverity; const text: AnsiString); overload;
    procedure Writeln(sev: TDzTraceSeverity; const text: WideString); overload;
    procedure FormatWrite(sev: TDzTraceSeverity; const fmt: AnsiString;
      const args: array of const); overload;
    procedure FormatWrite(sev: TDzTraceSeverity; const fmt: WideString;
      const args: array of const); overload;
  protected
    fVerbosity: TDzTraceVerbosity;
    fOptions: TTraceOptions;
    fDateTimeFormat: string;
    procedure SetVerbosity(const value: TDzTraceVerbosity); dynamic;
    procedure SetOptions(const value: TTraceOptions); dynamic;
    procedure SetDateTimeFormat(const value: string); dynamic;
    procedure WriteAnsi(const text: AnsiString); virtual; abstract;
    procedure WriteUnicode(const text: WideString); virtual; abstract;
  public
    constructor Create;
    procedure Flush; virtual; 
    property Severity: TDzTraceVerbosity read fVerbosity write fVerbosity;
    property Options: TTraceOptions read fOptions write fOptions;
    property DateTimeFormat: string read fDateTimeFormat write fDateTimeFormat;
  end;

  TDzFileTrace = class(TDzTrace)
  private
    fEncoding: TTextEncoding;
    fFileStream: TFileStream;
    function GetFileSize: Integer;
  protected
    function GetAttribute(const name: TNameString): Variant; override;
    procedure SetAttribute(const name: TNameString;
      const value: Variant); override;
    procedure WriteAnsi(const text: AnsiString); override;
    procedure WriteUnicode(const text: WideString); override;
  public
    constructor Create(const fileName: string);
    destructor Destroy; override;
    procedure Flush; override;
    property FileSize: Integer read GetFileSize;
    property Encoding: TTextEncoding read fEncoding write fEncoding;
  end;

  TConsoleTrace = class(TDzTrace)
  protected
    procedure WriteAnsi(const text: AnsiString); override;
    procedure WriteUnicode(const text: WideString); override;
  end;

  TDebuggerTrace = class(TDzTrace)
  protected
    procedure WriteAnsi(const text: AnsiString); override;
    procedure WriteUnicode(const text: WideString); override;
  end;
  
implementation

const
  SEVERITY_NAMESA: array [TDzTraceSeverity] of AnsiString =
  ('DEBUG', 'INFO', 'WARN', 'ERROR');
  SEVERITY_NAMESW: array [TDzTraceSeverity] of WideString =
  ('DEBUG', 'INFO', 'WARN', 'ERROR');

{ TDzTrace }

procedure TDzTrace.Write(sev: TDzTraceSeverity; const text: AnsiString);
begin
  if sev in Severity then
  begin
    if toSeverityTag in Options then 
    begin 
      WriteAnsi(SEVERITY_NAMESA[sev]);
      WriteAnsi(':: ')
    end;
    if toTimeTick in Options then
    begin
      WriteAnsi(AnsiString(FormatDateTime(DateTimeFormat, Now)));
      WriteAnsi(' ');
    end;
    WriteAnsi(text);
  end;
end;

procedure TDzTrace.Write(sev: TDzTraceSeverity; const text: WideString);
begin
  if sev in Severity then
  begin
    if toSeverityTag in Options then 
    begin 
      WriteUnicode(SEVERITY_NAMESW[sev]);
      WriteAnsi(':: ')
    end;
    if toTimeTick in Options then
    begin
      WriteUnicode(WideString(FormatDateTime(DateTimeFormat, Now)));
      WriteUnicode(' ');
    end;
    WriteUnicode(text);
  end;
end;

procedure TDzTrace.Writeln(sev: TDzTraceSeverity; const text: AnsiString);
begin
  if sev in Severity then
  begin
    if toSeverityTag in Options then 
    begin 
      WriteAnsi(SEVERITY_NAMESA[sev]);
      WriteAnsi(':: ')
    end;
    if toTimeTick in Options then
    begin
      WriteAnsi(AnsiString(FormatDateTime(DateTimeFormat, Now)));
      WriteAnsi(' ');
    end;
    WriteUnicode(text);
    WriteUnicode(#13#10);
  end;
end;

procedure TDzTrace.Writeln(sev: TDzTraceSeverity; const text: WideString);
begin
  if sev in Severity then
  begin
    if toSeverityTag in Options then 
    begin 
      WriteUnicode(SEVERITY_NAMESW[sev]);
      WriteAnsi(':: ');
    end;
    if toTimeTick in Options then
    begin
      WriteUnicode(WideString(FormatDateTime(DateTimeFormat, Now)));
      WriteUnicode(' ');
    end;
    WriteUnicode(text);
    WriteUnicode(#13#10);
  end;
end;

constructor TDzTrace.Create;
begin
  fDateTimeFormat := ShortTimeFormat;
  fVerbosity := TRACE_SEVERITIES_ALL;
  fOptions := [toSeverityTag, toTimeTick];
end;

procedure TDzTrace.FormatWrite(sev: TDzTraceSeverity; const fmt: AnsiString;
  const args: array of const);
begin
  Self.Write(sev, Format(fmt, args));
end;

procedure TDzTrace.Flush;
begin

end;

procedure TDzTrace.FormatWrite(sev: TDzTraceSeverity; const fmt: WideString;
  const args: array of const);
begin
  Self.Write(sev, WideFormat(fmt, args));
end;

function TDzTrace.GetDateTimeFormat: string;
begin
  Result := DateTimeFormat;
end;

function TDzTrace.GetOptions: TTraceOptions;
begin
  Result := Options;
end;

function TDzTrace.GetVerbosity: TDzTraceVerbosity;
begin
  Result := fVerbosity;
end;

procedure TDzTrace.SetDateTimeFormat(const value: string);
begin
  DateTimeFormat := value;
end;

procedure TDzTrace.SetOptions(const value: TTraceOptions);
begin
  Options := value;
end;

procedure TDzTrace.SetVerbosity(const value: TDzTraceVerbosity);
begin
  fVerbosity := value;
end;

{ TDzFileTrace }

constructor TDzFileTrace.Create(const fileName: string);
begin
  inherited Create;
  fEncoding := teAnsi;
  if not FileExists(fileName) then
  begin
    ForceDirectories(ExtractFilePath(fileName));
    FileClose(FileCreate(fileName));
  end;

  fFileStream := TFileStream.Create(fileName,
    fmOpenReadWrite or fmShareDenyWrite);

  fFileStream.Seek(0, soFromEnd);
end;

destructor TDzFileTrace.Destroy;
begin
  if fFileStream <> nil then fFileStream.Free;
  inherited;
end;

procedure TDzFileTrace.Flush;
begin
  Windows.FlushFileBuffers(fFileStream.Handle);
end;

function TDzFileTrace.GetAttribute(const name: TNameString): Variant;
begin
  if SameText(name, 'Encoding') then Result := Encoding
  else Result := inherited GetAttribute(name);
end;

function TDzFileTrace.GetFileSize: Integer;
begin
  Result := fFileStream.Size;
end;

procedure TDzFileTrace.SetAttribute(const name: TNameString;
  const value: Variant);
begin
  if SameText(name, 'Encoding') then Encoding := value
  else inherited;
end;

procedure TDzFileTrace.WriteAnsi(const text: AnsiString);
var
  utf8str: UTF8String;
  utf16str: WideString;
begin
  case Encoding of
    teAnsi: fFileStream.Write(text[1], Length(text));
    teUTF8:
      begin
        utf8str := uDZStr.AnsiToUtf8(text);
        fFileStream.Write(utf8str[1], Length(utf8str));
      end;
    teUTF16:
      begin
        utf16str := uDZStr.AnsiToUnicode(text);
        fFileStream.Write(utf16str[1], Length(utf16str) * 2);
      end;
  end;
end;

procedure TDzFileTrace.WriteUnicode(const text: WideString);
var
  ansistr: AnsiString;
  utf8str: UTF8String;
begin
  case Encoding of
    teAnsi:
      begin
        ansistr := uDZStr.UnicodeToAnsi(text);
        fFileStream.Write(ansistr[1], Length(ansistr));
      end;
    teUTF8:
      begin
        utf8str := uDZStr.Utf8Encode(text);
        fFileStream.Write(utf8str[1], Length(utf8str));
      end;
    teUTF16: fFileStream.Write(text[1], Length(text) * 2);
  end;
end;

{ TConsoleTrace }

procedure TConsoleTrace.WriteAnsi(const text: AnsiString);
begin
  System.Write(text);
end;

procedure TConsoleTrace.WriteUnicode(const text: WideString);
begin
  System.Write(text);
end;

{ TDebuggerTrace }

procedure TDebuggerTrace.WriteAnsi(const text: AnsiString);
begin
  OutputDebugStringA(PAnsiChar(text));
end;

procedure TDebuggerTrace.WriteUnicode(const text: WideString);
begin
  OutputDebugStringW(PWideChar(text));
end;

end.
